home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / toolhelp / pophelp.bas < prev    next >
BASIC Source File  |  1995-05-09  |  4KB  |  107 lines
  1. Option Explicit
  2.  
  3. Declare Function GetCapture% Lib "user" ()
  4. Declare Function WindowFromPoint Lib "User" (ByVal ptScreen As Any) As Integer
  5. Declare Function GetTextExtent& Lib "gdi" (ByVal hDC%, ByVal lpString$, ByVal nCount%)
  6. Declare Function GetWindowLong& Lib "user" (ByVal hWnd%, ByVal nIndex%)
  7. Declare Function SetWindowLong& Lib "user" (ByVal hWnd%, ByVal nIndex%, ByVal newLong&)
  8. Declare Function GetSystemMetrics% Lib "user" (ByVal nIndex%)
  9. Declare Sub SetWindowPos Lib "user" (ByVal hWnd%, ByVal hInsertAfter%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal wFlags%)
  10.  
  11. Type POINTAPI
  12.    X As Integer
  13.    Y As Integer
  14. End Type
  15.  
  16. Type RECT
  17.    Left As Integer
  18.    top As Integer
  19.    right As Integer
  20.    bottom As Integer
  21. End Type
  22.  
  23. Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
  24. Declare Sub GetWindowRect Lib "user" (ByVal hWnd%, lpRect As RECT)
  25.  
  26. Global Const GWL_STYLE = -16
  27. Global Const HWND_NOTOPMOST = -2
  28. Global Const HWND_TOPMOST = -1
  29. Global Const SM_CXCURSOR = 13
  30. Global Const SM_CYCURSOR = 14
  31. Global Const SWP_NOSIZE = &H1
  32. Global Const SWP_NOMOVE = &H2
  33. Global Const SWP_NOACTIVATE = &H10
  34. Global Const SWP_SHOWWINDOW = &H40
  35. Global Const SWP_NOZORDER = &H4
  36. Global Const WS_POPUP = &H80000000
  37.  
  38.  
  39. Global gPoint As POINTAPI
  40. Global gRect As RECT
  41. Global gCurrBtn As Integer
  42. Global gPopHelpActive As Integer
  43. Global gNumBtns As Integer
  44.  
  45. Function PointAPIToLong& (aPt As POINTAPI)
  46.  
  47.   PointAPIToLong& = (aPt.Y * (2 ^ 16)) Or (aPt.X)
  48.  
  49. End Function
  50.  
  51. Sub ShowHelpMess ()
  52.  
  53.   Dim w         As Integer
  54.   Dim h         As Integer
  55.   Dim cx        As Integer
  56.   Dim cy        As Integer
  57.   Dim message   As String
  58.   Dim flags     As Integer
  59.   Dim hWndOver  As Integer
  60.  
  61.  ' set help window size based on length of message text
  62.  message = MDIForm1!pshToolBtn(gCurrBtn).Tag
  63.  w = GetTextExtent(frmPopupHelp!Picture1.hDC, message, Len(message)) And &HFF
  64.  h = GetTextExtent(frmPopupHelp!Picture1.hDC, message, Len(message)) \ 2 ^ 16
  65.  ' fudge factor
  66.  frmPopupHelp!Picture1.Width = w + 6
  67.  frmPopupHelp!Picture1.Height = h + 1
  68.  
  69.  frmPopupHelp.Height = frmPopupHelp!Picture1.Height * screen.TwipsPerPixelY
  70.  frmPopupHelp.Width = frmPopupHelp!Picture1.Width * screen.TwipsPerPixelX
  71.  
  72.  ' print help message
  73.  frmPopupHelp!Picture1.Cls
  74.  frmPopupHelp!Picture1.CurrentY = -1
  75.  frmPopupHelp!Picture1.CurrentX = 2
  76.  frmPopupHelp!Picture1.Print message
  77.  
  78.  ' position help message window relative to cursor
  79.  Call GetCursorPos(gPoint)
  80.  cy = GetSystemMetrics(SM_CYCURSOR)
  81.  ' fudge factors
  82.  frmPopupHelp.top = (gPoint.Y + cy - 10) * screen.TwipsPerPixelY
  83.  frmPopupHelp.Left = (gPoint.X - 2) * screen.TwipsPerPixelX
  84.  
  85.  ' Adjust position of popup if needed, ie - don't let
  86.  ' message run off screen
  87.  If frmPopupHelp.top + frmPopupHelp.Height > screen.Height Then
  88.    frmPopupHelp.top = screen.Height - frmPopupHelp.Height
  89.    ' don't cover the button either
  90.    hWndOver = WindowFromPoint(PointAPIToLong&(gPoint))
  91.    Call GetWindowRect(hWndOver, gRect)
  92.    If frmPopupHelp.top + frmPopupHelp.Height > gRect.top * screen.TwipsPerPixelY Then
  93.       frmPopupHelp.top = (gRect.top * screen.TwipsPerPixelY) - frmPopupHelp.Height
  94.     End If
  95.  End If
  96.  
  97.  If frmPopupHelp.Left + frmPopupHelp.Width > screen.Width Then
  98.    frmPopupHelp.Left = screen.Width - frmPopupHelp.Width
  99.  End If
  100.  
  101.  ' display window;  SWP_NOACTIVATE is the key here...
  102.  flags = SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
  103.  Call SetWindowPos(frmPopupHelp.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
  104.  
  105. End Sub
  106.  
  107.